home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / STRUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-20  |  4KB  |  168 lines
  1. UNIT StrUtil;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ String utilities                              Last changed: 20.04.96  DW ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-93 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, PoPTypes;
  16.  
  17. FUNCTION  ReplaceEnv(S: String): String;
  18. FUNCTION  NextWord(ch:CHAR; VAR s:STRING):STRING;
  19. FUNCTION  ReverseStr(CONST s: STRING): STRING;
  20. FUNCTION  CPad(CONST s: String; l: Byte): String;
  21. FUNCTION  Address2Str(CONST Address: TFidoAddress): S40;
  22. PROCEDURE Replace(VAR S1: String; CONST S2, S3: String; N: Integer);
  23. FUNCTION  Asciiz2Str(VAR AsciiZStr; MaxLen: Byte): String;
  24. PROCEDURE Str2AsciiZ(InStr: String; VAR AsciiZStr; Len: Byte);
  25. FUNCTION  ReplaceStr(InStr: String; CONST FName: S12): String;
  26. FUNCTION  ToChar(x : Word): S2;
  27. FUNCTION  Address(Net, Node: Integer): S8;
  28.  
  29. IMPLEMENTATION
  30.  
  31. USES OpString, Dos;
  32.  
  33.   FUNCTION ReplaceEnv(S: String): String;
  34.   Var
  35.     x,y,z : byte;
  36.     tmp   : String;
  37.   Begin
  38.     IF (Length(s)>3) AND (Pos('%',s)<>0) Then
  39.     BEGIN
  40.       z:=1;
  41.       WHILE z<Length(s) DO
  42.       BEGIN
  43.         x:=z;
  44.         WHILE (s[x]<>'%') AND (x<=Length(s)) DO
  45.           Inc(x);
  46.         y:=x+1;
  47.         WHILE NOT (s[y] in ['%',' ']) AND (y<Length(s)) DO
  48.           Inc(y);
  49.         IF s[y]=' ' THEN
  50.           z:=y+1
  51.         ELSE
  52.           IF (y<=Length(s)) AND (s[y]<>'%') THEN
  53.             z:=255
  54.           ELSE
  55.           BEGIN
  56.             Tmp:=GetEnv(StUpCase(Copy(s,x+1,y-x-1)));
  57.             Delete(s,x,y-x+1);
  58.             Insert(Tmp,s,x);
  59.             z:=x+Length(Tmp);
  60.           END;
  61.       END;
  62.     END;
  63.     ReplaceEnv:=S;
  64.   END;
  65.  
  66.   FUNCTION NextWord(ch: Char; VAR s: STRING): STRING;
  67.   VAR
  68.     ss : STRING;
  69.     p:BYTE;
  70.   BEGIN
  71.     p:=POS(ch,s);
  72.     IF p>0 THEN
  73.     BEGIN
  74.       ss:=Copy(s, 1, Pos(ch,s)-1);
  75.       Delete(s, 1, Length(ss)+1);
  76.     END
  77.     ELSE
  78.     BEGIN
  79.       ss:=s;
  80.       s:='';
  81.     END;
  82.     NextWord:=ss;
  83.   END;
  84.  
  85.   FUNCTION ReverseStr(CONST s:STRING): STRING;
  86.   VAR
  87.     ss : STRING;
  88.     i  : Byte;
  89.   BEGIN
  90.     ss:='';
  91.     FOR i:=Length(s) DOWNTO 1 DO
  92.       ss:=ss+s[i];
  93.     ReverseStr:=ss;
  94.   END;
  95.  
  96.   FUNCTION CPad(CONST s: String; l: Byte): String;
  97.   BEGIN
  98.     CPad:=Copy(Pad(s,l),1,l);
  99.   END;
  100.  
  101.   FUNCTION  Address2Str(CONST Address: TFidoAddress): S40;
  102.   BEGIN
  103.     WITH Address DO
  104.       Address2Str:=Long2Str(Zone)+':'+Long2Str(Net)+'/'+Long2Str(Node)+'.'+Long2Str(Point);
  105.   END;
  106.  
  107.   FUNCTION ReplaceStr(InStr: String; CONST FName: S12): String;
  108.   VAR
  109.     i : Byte;
  110.   BEGIN
  111.     FOR i:=Length(FName) DOWNTO 1 DO
  112.     BEGIN
  113.       Replace(InStr,'$'+Long2Str(i),FName[i],0);
  114.     END;
  115.     ReplaceStr:=InStr;
  116.   END;
  117.  
  118.   FUNCTION Asciiz2Str(VAR AsciiZStr; MaxLen: Byte): String;
  119.   VAR
  120.     AsciiZArray    : ARRAY[1..254] OF Char ABSOLUTE AsciiZStr;
  121.     Tmp            : String;
  122.     a              : Byte;
  123.   BEGIN
  124.     Tmp:='';
  125.     a:=1;
  126.     WHILE (AsciiZArray[a] <> #0) AND (a <= MaxLen) DO
  127.     BEGIN
  128.       Tmp:=Tmp+AsciiZArray[a];
  129.       Inc(a);
  130.     END;
  131.     Asciiz2Str:=Tmp;
  132.   END;
  133.  
  134.   PROCEDURE Str2AsciiZ(InStr: String; VAR AsciiZStr; Len:BYTE);
  135.   BEGIN
  136.     FillChar(AsciiZStr, Len, 0);
  137.     IF Length(InStr)<Len THEN Len:=Length(InStr) ELSE Dec(Len);
  138.     Move(InStr[1], AsciiZStr, Len);
  139.   END;
  140.  
  141.   PROCEDURE Replace(VAR S1: String; CONST S2, S3: String; N: Integer);
  142.   VAR
  143.     i              : Byte;
  144.   BEGIN
  145.     REPEAT
  146.       i := pos(S2, S1);
  147.       n := 0;
  148.       IF i > 0 THEN
  149.       BEGIN
  150.         Delete(S1, i, Length(S2));
  151.         Insert(S3, S1, i);
  152.         Dec(n);
  153.       END;
  154.     UNTIL (i = 0) OR (n = 0);
  155.   END;
  156.  
  157.   FUNCTION tochar(x: Word) : S2;
  158.   BEGIN
  159.     ToChar := LongIntForm('@@', x);
  160.   END;
  161.  
  162.   FUNCTION Address(Net, Node : Integer) : S8;
  163.   BEGIN
  164.     Address:=HexW(WORD(Net))+HexW(WORD(Node));
  165.   END;
  166.  
  167. END.
  168.